{-# LANGUAGE KindSignatures                #-}
{-# LANGUAGE MultiParamTypeClasses         #-}
{-# LANGUAGE FlexibleContexts              #-}
{-# LANGUAGE FlexibleInstances             #-}
{-# LANGUAGE ScopedTypeVariables               #-}
{-# LANGUAGE ExistentialQuantification     #-}
{-# LANGUAGE GADTs                         #-}
{-# LANGUAGE RankNTypes                    #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Dependencies.Consistency
-- Copyright   :  (c) 2009--2010 TU Dortmund
-- License     :  BSD3
--
-- Maintainer  :  menge@udo.cs.uni-dortmund.de
-- Stability   :  experimental
-- Portability :  non-portable
--
-- This module contains a number of "private" language specific consistency 
-- functions. It exports only the check function which delegates to References.plc 
-- based on file-extensions.
--
-- In other contexts, other languages and corresponding consistency functions 
-- could be used instead.
--
-----------------------------------------------------------------------------

module Language.Dependencies.Consistency
  ( check, languages ) where

import Language.Dependencies.References
import Language.Dependencies.Language

-- Multirec-Adapter

import qualified Language.Dependencies.Adaptors.Map as Map
import qualified Language.Dependencies.Adaptors.ASTExpr as Expr
import qualified Language.Dependencies.Adaptors.Python as Python
import Language.Dependencies.Adaptors.XML
import Language.Dependencies.Adaptors.Json
--import Language.Dependencies.Adaptors.Haskell 
import Language.Dependencies.Adaptors.Java
import Language.Dependencies.Adaptors.Html
--import Language.Dependencies.Adaptors.C


-- system
import System.FilePath.Posix (takeExtension)


-- a list of supported languages
languages :: [Language]
languages = [Map.languagemap
            ,Expr.languageexpr
            ,languagexml
            ,languagejson
            ,languagehtml
            ,Python.languagepython
            ,languagejava
--            ,haskellexts
--            ,languagec
            ]


-- | the essential check function
-- this binds based on the extensions the correct consistency 
-- functions, typereps and parse-functions and calls 
-- "plc" (parse-locate-compare) on the Relataion.
check :: Relation -> IO Bool
check r@(Relation (Elem (DPath pf1) fp1) (Elem (DPath pf2) fp2) cf) = do
    let ext1 = takeExtension fp1
    let ext2 = takeExtension fp2
    case (ext1,ext2) of
      (".map",".map")  -> plc (Map.TheMap) (Map.TheMap) parseM parseM (cMM cf) r
      (".map",".ast")  -> plc (Map.TheMap) (Expr.TheExpr) parseM parseA (cMA cf) r
--      (".py",".py")  -> plc (TheModuleSpan) (TheModuleSpan) parseP parseP (cPP cf) r
      (lext,rext) -> error $ "comparing filetypes "++lext++" and "++rext++" is currently not supported. exiting"


-- ******************           PARSING           **************************


parseM :: String -> Map.Map
parseM x = let Right a = (Map.parseMap) x in a

parseP :: String -> Python.ModuleSpan
parseP x = let Right a = Python.parPython x in a

parseA :: String -> Expr.Expr
parseA x = let Right a = Expr.fromString x in a 


-- parseJ :: String -> J.Program
-- parseJ x = let Right a = (parJava) x in a


-- ******************           COMPARING           **************************

cMM :: CompareId -> Map.MAP ix1 -> Map.MAP ix2 -> ix1 -> ix2 -> Bool

cMM (CompareId "keys") Map.TheEntry Map.TheEntry (Map.E k1 v1 _) (Map.E k2 v2 _) = k1 == k2
cMM (CompareId "keysvalues") Map.TheEntry Map.TheEntry (Map.E k1 v1 _) (Map.E k2 v2 _) = k1 == k2 && v1 == v2

cMM cf Map.TheMap Map.TheMap (Map.Cons e1 m1 _) (Map.Cons e2 m2 _) = (cMM cf Map.TheEntry Map.TheEntry e1 e2) && cMM cf Map.TheMap Map.TheMap m1 m2
cMM cf Map.TheMap Map.TheMap (Map.Empty _) (Map.Empty _)= True
cMM _ _ _ _ _ = error "undefined"


cMA :: CompareId -> Map.MAP ix1 -> Expr.AST ix2 -> ix1 -> ix2 -> Bool

cMA (CompareId "keys") Map.TheEntry Expr.TheExpr (Map.E k v _) (Expr.EVar _ var) = (k == var)
cMA (CompareId "keys") Map.TheEntry Expr.TheExpr (Map.E k v _) (Expr.Const _ _) = True 
cMA (CompareId "keys") Map.TheEntry Expr.TheExpr m@(Map.E k v _) e@(Expr.Neg _ r) = cMA undefined Map.TheEntry Expr.TheExpr m r
cMA (CompareId "keys") Map.TheEntry Expr.TheExpr m@(Map.E k v _) e@(Expr.Add _ r1 r2) = cMA undefined Map.TheEntry Expr.TheExpr m r1
                                                                                         && cMA undefined Map.TheEntry Expr.TheExpr m r2
cMA (CompareId "keys") Map.TheEntry Expr.TheExpr m@(Map.E k v _) e@(Expr.Mul _ r1 r2) = cMA undefined Map.TheEntry Expr.TheExpr m r1
                                                                                         && cMA undefined Map.TheEntry Expr.TheExpr m r2
cMA (CompareId "keys") Map.TheEntry Expr.TheExpr m@(Map.E k v _) e@(Expr.Let _ d r) = cMA undefined Map.TheEntry Expr.TheExpr m r
                                                                                         && cMA undefined Map.TheEntry Expr.TheDecl m d
cMA (CompareId "keys") Map.TheEntry Expr.TheDecl m@(Map.E k v _) e@((Expr.:=) _ c exp) = cMA undefined Map.TheEntry Expr.TheExpr m exp
                                                                                         && k == c
cMA (CompareId "keys") Map.TheEntry Expr.TheDecl m@(Map.E k v _) e@(Expr.None _) = True
cMA (CompareId "keys") Map.TheEntry Expr.TheDecl m@(Map.E k v _) e@(Expr.Seq _ r1 r2) = cMA undefined Map.TheEntry Expr.TheDecl m r1
                                                                       && cMA undefined Map.TheEntry Expr.TheDecl m r2

cMA (CompareId "eval") Map.TheEntry Expr.TheExpr (Map.E k v _) exp = (v == Expr.eval exp)
cMA _ _ _ _ _ = error "consistency function cMA is not defined for this combination of constructors"


cMP :: CompareId -> Map.MAP ix1 -> Python.PYTHON ix2 -> ix1 -> ix2 -> Bool
cMP _ Map.TheEntry Python.TheIdentSpan (Map.E k v _) (Python.Ident s _) = [k] == s
cMP _ _ _ _ _ = error "undefined"


cPP :: CompareId -> Python.PYTHON ix1 -> Python.PYTHON ix2 -> ix1 -> ix2 -> Bool
cPP _ Python.TheExprSpan Python.TheExprSpan (Python.Strings ss1 _) (Python.Strings ss2 _) = ss1 == ss2
cPP _ _ _ _ _ = error "undefined"


-- cJJ :: MJ.JAVA ix1 -> MJ.JAVA ix2 -> ix1 -> ix2 -> Bool
-- cJJ _ _ _ _ = error "undefined"

